Option Explicit
Sub K_Sample011()
    Dim myRng  As Range
    Dim myAr() As Variant
    Dim myCnt  As Long
    Dim myTmp  As Long
    Dim I      As Long
    Dim J      As Long
    Dim myFlg  As Boolean
    myCnt = 3000                                        '}Cn
    ReDim myAr(1 To myCnt)
    Set myRng = Worksheets.Add.Cells(1, 1)
    '}Cs@P
    For I = 1 To myCnt
        Randomize
        myAr(I) = Int((myCnt * 5) * Rnd + 1)
        myRng.Cells(I) = myAr(I)
    Next
    myAr = E_Sample011_1(myAr)
    'myAr = E_Sample011_2(myAr)
    With myRng.Offset(, 3)
        For I = 1 To myCnt
            .Cells(I) = myAr(I)
        Next
    End With
    'MsgBox "Ƨǧ"
    Set myRng = Nothing                                    '
End Sub

Function E_Sample011_1(myAr As Variant) As Variant
    Dim myTmp   As Long
    Dim myAr1() As Long
    Dim myAr2() As Long
    Dim mySplt  As Long
    Dim myUbnd  As Long
    Dim I       As Long
    Dim J       As Long
    Dim k       As Long
    myUbnd = UBound(myAr)
    Select Case myUbnd
        Case 2
            If myAr(1) > myAr(2) Then
                myTmp = myAr(1)
                myAr(1) = myAr(2)
                myAr(2) = myTmp
            End If
            E_Sample011_1 = myAr
            Exit Function
        Case Else
            mySplt = myUbnd \ 2
            'eb
            ReDim myAr1(1 To mySplt) As Long
            For I = 1 To mySplt
                myAr1(I) = myAr(I)
            Next
            If mySplt > 1 Then
                myAr1 = E_Sample011_1(myAr1)
            End If
            'b
            ReDim myAr2(1 To myUbnd - mySplt) As Long
            For I = 1 To myUbnd - mySplt
                myAr2(I) = myAr(mySplt + I)
            Next
            If myUbnd - mySplt > 1 Then
                myAr2 = E_Sample011_1(myAr2)
            End If
            'XփW
            I = 1
            J = 1
            k = 1
            Do
                If I > mySplt Then
                        myAr(k) = myAr2(J)
                        J = J + 1
                ElseIf J > myUbnd - mySplt Then
                        myAr(k) = myAr1(I)
                        I = I + 1
                Else
                    If myAr1(I) < myAr2(J) Then
                        myAr(k) = myAr1(I)
                        I = I + 1
                    Else
                        myAr(k) = myAr2(J)
                        J = J + 1
                    End If
                End If
                k = k + 1
            Loop Until k > myUbnd
            E_Sample011_1 = myAr
            Exit Function
    End Select
End Function

Function E_Sample011_2(myAr As Variant) As Variant
    Dim myTmp   As Long
    Dim myAr1() As Long
    Dim myAr2() As Long
    Dim myCntr  As Long
    Dim myUbnd  As Long
    Dim I       As Long
    Dim J       As Long
    Dim k       As Long
    Dim Cdata   As Long
    myUbnd = UBound(myAr)
    myCntr = myAr((myUbnd) \ 2 + 1)
    I = 0: J = myUbnd + 1
    Do
        Do
            I = I + 1
        Loop While myAr(I) < myCntr
        Do
            J = J - 1
        Loop While myAr(J) > myCntr
        If I >= J Then Exit Do
        myTmp = myAr(J)
        myAr(J) = myAr(I)
        myAr(I) = myTmp
    Loop
    I = I - 1
    'eb
    ReDim myAr1(1 To I) As Long
    For k = 1 To I
        myAr1(k) = myAr(k)
    Next
    If I > 1 Then
        myAr1 = E_Sample011_1(myAr1)
    End If
    'b
    ReDim myAr2(1 To myUbnd - I) As Long
    For k = 1 To myUbnd - I
        myAr2(k) = myAr(k + I)
    Next
    If myUbnd - I > 1 Then
        myAr2 = E_Sample011_1(myAr2)
    End If
    'XփW
    For k = 1 To I
        myAr(k) = myAr1(k)
    Next
    For k = 1 To myUbnd - I
        myAr(k + I) = myAr2(k)
    Next
    E_Sample011_2 = myAr
    Exit Function
End Function

